{ SUBROUTINES FOR ADVENTURE } 

PROCEDURE NAMEANDPW;

VAR
  ACHR : CHAR;
  ACHAR : STRING[1];

BEGIN { NAMEANDPW }
  WRITELN('Enter your name please.');
  READLN(NAMEOFUSER);
  WRITELN('Enter your password.');
  READ(KEYBOARD, ACHR);
  if ACHR in ['a'..'z'] then ACHR := chr(ord(ACHR) - 32);
  ACHAR := ' ';
  TESTPW := '';
  WHILE NOT EOLN(KEYBOARD) DO
    BEGIN
      ACHAR[1] := ACHR;
      IF ACHR = CHR(8) THEN
        IF LENGTH(TESTPW) > 0 THEN
          BEGIN
            DELETE(TESTPW, LENGTH(TESTPW), 1);
            WRITE(CHR(8), ' ', CHR(8))
          END
        ELSE
      ELSE
        BEGIN
          WRITE('X');
          TESTPW := CONCAT(TESTPW, ACHAR)
        END;
      READ(KEYBOARD, ACHR);
      if ACHR in ['a'..'z'] then ACHR := chr(ord(ACHR) - 32)
    END;
  NAMEOFUSER := CONCAT(NAMEOFUSER, '.AVSV')
END;  { NAMEANDPW }


FUNCTION GETSCORE{SCORECMD : BOOLEAN) : INTEGER};

VAR
  I, K, SCORE : INTEGER;

BEGIN { GETSCORE }
  MAXSCORE := 0;
  SCORE := 0;
  FOR I := 50 TO MAXTRS DO
    IF ARY^.PTEXT[I] <> 0 THEN
      BEGIN
        IF I = CHEST THEN
          K := 20
        ELSE
          IF I > CHEST THEN
            K := 16
          ELSE
            K := 12;
        IF (VARY^.PROP[I] >= 0) THEN SCORE := SCORE + 2;
        IF (VARY^.PLACE[I] = 3) AND (VARY^.PROP[I] = 0) THEN
          SCORE := SCORE + K - 2;
        MAXSCORE := MAXSCORE + K
      END;
  SCORE := SCORE + (MAXDIE - VBL^.NUMDIE) * 10;
  MAXSCORE := MAXSCORE + MAXDIE * 10;
  IF VBL^.DFLAG <> 0 THEN SCORE := SCORE + 25;
  MAXSCORE := MAXSCORE + 25;
  IF NOT (GAVEUP OR SCORECMD) THEN SCORE := SCORE + 4;
  MAXSCORE := MAXSCORE + 4;
  IF VBL^.CLOSING THEN SCORE := SCORE + 25;
  MAXSCORE := MAXSCORE + 25;
  CASE BONUS OF
    0 : SCORE := SCORE + 10;
    135 : SCORE := SCORE + 25;
    134 : SCORE := SCORE + 30;
    133 : SCORE := SCORE + 45
  END;
  MAXSCORE := MAXSCORE + 45;
  IF VARY^.PLACE[MAGAZINE] = 108 THEN SCORE := SCORE + 1;
  MAXSCORE := MAXSCORE + 1;
  SCORE := SCORE + 2;
  MAXSCORE := MAXSCORE + 2;
  FOR I := 1 TO HNTSIZ DO
    IF VARY^.HINTED[I] THEN SCORE := SCORE - ARY^.HINTS[I, 2];
  GETSCORE := SCORE
END;  { GETSCORE }


FUNCTION TOTING{OBJECT : INTEGER) : BOOLEAN};

BEGIN
  TOTING := (VARY^.PLACE[OBJECT] = -1)
END;  { TOTING } 


FUNCTION AT{OBJECT : INTEGER) : BOOLEAN};

BEGIN
  AT := (VARY^.PLACE[OBJECT] = VBL^.LOC) OR (VARY^.FIXED[OBJECT] = VBL^.LOC)
END;  { AT }


FUNCTION MIN{I, J : INTEGER) : INTEGER};

BEGIN { MIN }
  IF J < I THEN
    MIN := J
  ELSE
    MIN := I
END;  { MIN }


FUNCTION MAX{I, J : INTEGER) : INTEGER};

BEGIN { MAX }
  IF J > I THEN
    MAX := J
  ELSE
    MAX := I
END;  { MAX }


FUNCTION RAN{NUM : INTEGER) : INTEGER};

VAR
  TEMP : INTEGER;
  TEMP2 : REAL;

BEGIN { RAN }
  TEMP := SEED * 899;
  IF TEMP < 0 THEN TEMP := TEMP + 32767 + 1;
  TEMP2 := (TEMP - 1) / 32767.0;
  RAN := TRUNC(TEMP2 * NUM);
  SEED := TEMP
END;  { RAN }


FUNCTION PERCENT{I : INTEGER) : BOOLEAN};

BEGIN
  PERCENT := (RAN(100) < I)
END;  { PERCENT }


FUNCTION HERE{OBJECT : INTEGER) : BOOLEAN};

BEGIN
  HERE := (VARY^.PLACE[OBJECT] = VBL^.LOC) OR TOTING(OBJECT)
END;  { HERE }


FUNCTION DARK {: BOOLEAN};

BEGIN
  DARK := ((VARY^.COND[VBL^.LOC] MOD 2) = 0) AND ((VARY^.PROP[LAMP] = 0) OR
    NOT HERE(LAMP))
END;  { DARK }


FUNCTION FORCED{LOC : INTEGER) : BOOLEAN};

BEGIN
  FORCED := VARY^.COND[LOC] = 2
END;  { FORCED }


FUNCTION BITSET{I, J : INTEGER) : BOOLEAN};

VAR
  K, TEMP : INTEGER;

BEGIN { BITSET }
  TEMP := VARY^.COND[I];
  FOR K := 1 TO J DO TEMP := TEMP DIV 2;
  BITSET := (TEMP MOD 2) = 1
END;  { BITSET }


FUNCTION LIQ2{PBOTL : INTEGER) : INTEGER};

VAR
  TEMP : INTEGER;

BEGIN { LIQ2 }
  TEMP := PBOTL DIV 2;
  LIQ2 := ((1 - PBOTL) * WATER + TEMP * (WATER + OIL))
END;  { LIQ2 }


FUNCTION LIQ {: INTEGER};

BEGIN
  LIQ := LIQ2(MAX(VARY^.PROP[BOTTLE], -1 - VARY^.PROP[BOTTLE]))
END;  { LIQ }


FUNCTION LIQLOC{LOC : INTEGER) : INTEGER};

VAR
  TEMP1, TEMP2 : INTEGER;

BEGIN { LIQLOC }
  TEMP1 := (VARY^.COND[LOC] DIV 2) * 2;  { EVEN COND ONLY }
  TEMP2 := VARY^.COND[LOC] DIV 4;
  LIQLOC := LIQ2((TEMP1 MOD 8 - 5) * (TEMP2 MOD 2) + 1)
END;  { LIQLOC }


FUNCTION VOCAB{WORD : STRING;WHAT : INTEGER) : INTEGER};

VAR
  I, J, K : INTEGER;

BEGIN { VOCAB }
  I := 1;
  J := tabsiz;
  REPEAT
    K := (I + J) DIV 2;
    IF ARY^.ATAB[K] <= WORD THEN I := K + 1; 
    IF ARY^.ATAB[K] >= WORD THEN J := K - 1
  UNTIL I > J;
  IF K > 1 THEN
    IF ARY^.ATAB[K - 1] = WORD THEN K := K - 1;  { FIND FIRST WORD }
  VOCAB := -1;
  IF ARY^.ATAB[K] = WORD THEN VOCAB := ARY^.KTAB[K];
  IF WHAT >= 0 THEN
    BEGIN
      WHILE (ARY^.ATAB[K] = WORD) AND (WHAT <> (ARY^.KTAB[K] DIV 1000)) DO
        K := K + 1;
      IF ARY^.ATAB[K] = WORD THEN VOCAB := ARY^.KTAB[K] MOD 1000
    END
END;  { VOCAB }


PROCEDURE CARRY{OBJECT, WHERE : INTEGER};

VAR
  TEMP : INTEGER;


  PROCEDURE LINKUP;

  BEGIN { LINKUP }
    TEMP := VARY^.ATLOC[WHERE];
    WHILE (VARY^.LINK[TEMP] <> OBJECT) DO TEMP := VARY^.LINK[TEMP];
    VARY^.LINK[TEMP] := VARY^.LINK[OBJECT]
  END;  { LINKUP }


BEGIN { CARRY }
  IF OBJECT <= 100 THEN
    IF VARY^.PLACE[OBJECT] <> -1 THEN
      BEGIN
        VARY^.PLACE[OBJECT] := -1;
        VBL^.HLDING := VBL^.HLDING + 1;
        IF VARY^.ATLOC[WHERE] = OBJECT THEN
          VARY^.ATLOC[WHERE] := VARY^.LINK[OBJECT]
        ELSE
          LINKUP
      END
    ELSE
  ELSE
    IF VARY^.ATLOC[WHERE] = OBJECT THEN
      VARY^.ATLOC[WHERE] := VARY^.LINK[OBJECT] 
    ELSE
      LINKUP
END;  { CARRY }


PROCEDURE DROP{OBJECT, WHERE : INTEGER};

BEGIN
  IF OBJECT > 100 THEN
    VARY^.FIXED[OBJECT - 100] := WHERE
  ELSE
    BEGIN
      IF VARY^.PLACE[OBJECT] = -1 THEN VBL^.HLDING := VBL^.HLDING - 1;
      VARY^.PLACE[OBJECT] := WHERE
    END;
  IF WHERE > 0 THEN
    BEGIN
      VARY^.LINK[OBJECT] := VARY^.ATLOC[WHERE];
      VARY^.ATLOC[WHERE] := OBJECT
    END
END;  { DROP }


PROCEDURE MOVE{OBJECT, WHERE : INTEGER};

VAR
  FROM : INTEGER;

BEGIN { MOVE }
  IF OBJECT > 100 THEN
    FROM := VARY^.FIXED[OBJECT - 100]
  ELSE
    FROM := VARY^.PLACE[OBJECT];
  IF (FROM > 0) AND (FROM <= 300) THEN CARRY(OBJECT, FROM);
  DROP(OBJECT, WHERE)
END;  { MOVE }


PROCEDURE JUGGLE{OBJECT : INTEGER};

BEGIN
  MOVE(OBJECT, VARY^.PLACE[OBJECT]);
  MOVE(OBJECT + 100, VARY^.FIXED[OBJECT])
END;  { JUGGLE }


PROCEDURE DESTROY{OBJECT : INTEGER};

BEGIN
  MOVE(OBJECT, 0)
END;  { DESTROY }


FUNCTION PUT{OBJECT, WHERE, PVAL : INTEGER) : INTEGER};

BEGIN
  MOVE(OBJECT, WHERE);
  PUT := -1 - PVAL
END;  { PUT }


PROCEDURE SPEAK{MSG : INTEGER};

VAR
  I : INTEGER;
  MTEMP : STRING[6];
  MTEMP2 : STRING;
  MTEXT : STRING[255];


  PROCEDURE HOLDUP;

  BEGIN { HOLDUP }
    LINE := LINE + 1;
    IF LINE >= (TERMHIGHT - 1) THEN
      BEGIN
        LINE := 1;
        WRITE(CHR(7), '         Press <RETURN> to continue.');
        READLN
      END
  END;  { HOLDUP }


BEGIN { SPEAK }
  MTEMP := '      ';
  MTEXT := '';
  IF MSG > 0 THEN
    BEGIN
      SEEK(MSGFILE, MSG);
      REPEAT
        GET(MSGFILE);
        FOR I := 1 TO 6 DO MTEMP[I] := MSGFILE^[I];
        IF ORD(MTEMP[1]) > 128 THEN MTEMP[1] := CHR(ORD(MTEMP[1]) - 128);
        IF ORD(MTEMP[2]) > 128 THEN MTEMP[2] := CHR(ORD(MTEMP[2]) - 128);
        MTEXT := CONCAT(MTEXT, MTEMP);
        IF LENGTH(MTEXT) > TERMWIDTH THEN
          BEGIN
            I := TERMWIDTH;
            WHILE MTEXT[I] <> ' ' DO I := I - 1;
            MTEMP2 := COPY(MTEXT, 1, I - 1);
            DELETE(MTEXT, 1, I);
            WRITELN(MTEMP2);
            HOLDUP
          END
      UNTIL ORD(MSGFILE^[1]) > 128;
      IF MTEXT <> '      ' THEN  { DONT PRINT DUMMY MSG }
        BEGIN
          WRITELN(MTEXT);
          HOLDUP
        END
    END
END;  { SPEAK }


PROCEDURE PSPEAK{MSG, SKIP : INTEGER};

VAR
  I, M : INTEGER;

BEGIN { PSPEAK }
  M := ARY^.PTEXT[MSG];
  SEEK(MSGFILE, M);
  FOR I := 0 TO SKIP DO
    BEGIN
      REPEAT
        GET(MSGFILE);
        M := M + 1
      UNTIL ORD(MSGFILE^[1]) > 128
    END;
  GET(MSGFILE);  { INSURE GET BETWEEN SEEKS }
  SPEAK(M)
END;  { PSPEAK }


FUNCTION YES{MSG, SPKYES, SPKNO : INTEGER) : BOOLEAN};

VAR
  i : integer;
  INLINE : STRING;

BEGIN { YES }
  YEA := FALSE;
  SKIPIT := FALSE;
  IF MSG <> 0 THEN SPEAK(ARY^.RTEXT[MSG]);
  LINE := 1;
  REPEAT
    IF SKIPIT THEN WRITELN('Please answer the question with yes or no.');
    SKIPIT := TRUE;
    READLN(INLINE);
    for i := 1 to length(INLINE) do
      if INLINE[i] in ['a'..'z'] then INLINE[i] := chr(ord(INLINE[i]) - 32)
  UNTIL (INLINE = 'YES') OR (INLINE = 'Y') OR (INLINE = 'NO') OR
    (INLINE = 'N');
  YEA := (INLINE = 'YES') OR (INLINE = 'Y');
  IF YEA THEN SPKNO := SPKYES;
  IF SPKNO <> 0 THEN SPEAK(ARY^.RTEXT[SPKNO]);
  YES := YEA
END;  { YES }


PROCEDURE ERRORHALT{I : INTEGER};

BEGIN 
  WRITELN;
  WRITELN('Fatal error # ', I, ' ---- Bye!');
  HALT
END;  { ERRORHALT }


PROCEDURE TESTCLOSE;

VAR
  I : INTEGER;

BEGIN { TESTCLOSE }
  IF (NEWLOC IN [1..8]) AND VBL^.CLOSING THEN
    BEGIN
      SPEAK(ARY^.RTEXT[130]);
      NEWLOC := VBL^.LOC;
      IF NOT VBL^.PANIC THEN VBL^.CLOCK2 := 15;
      VBL^.PANIC := TRUE
    END;
  IF (NEWLOC <> VBL^.LOC) AND NOT FORCED(VBL^.LOC)
    AND NOT BITSET(VBL^.LOC, 3) THEN
    FOR I := 1 TO 5 DO
      IF (VARY^.ODLOC[I] = NEWLOC) AND VARY^.DSEEN[I] THEN
        BEGIN
          NEWLOC := VBL^.LOC;
          SPEAK(ARY^.RTEXT[2]);
          I := 5
        END
END;  { TESTCLOSE }



